unit APIHook;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs,StdCtrls;

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure FormMouseUp(Sender: TObject; 
                                                Button: TMouseButton;
                                                Shift: TShiftState; 
                                                 X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

  mdx,mdy    :integer;
  isGetText:Bool;

implementation

{$R *.DFM}

type

PImportJump = ^TImportJump;
TImportJumP = packed record
JMP : WORD;
Proc : ^POINTER;
end;

type fExtTextOut=function (DC:HDC;X,Y,opt:integer;
                                           Rect:PRect;St:PChar;
                                           count,dx:integer):BOOL;stdcall;

var f:fExtTextOut;  

function NewExtTextOut(DC:HDC;X,Y,opt:integer;
                                           Rect:PRect;St:PChar;
                                           count,dx:integer):BOOL;stdcall;

var 
      size :tagSize; 
      tm      :TagTextmetrica; 
       p       :Integer;
      s,tmp:String; 
      I         :integer; 
begin
  if isGetText then begin

     GetTextExtentPoint(DC,st,count,size);
     GetTextMetrics(DC,tm);

     if ((mdx>=x) and (mdx<=x+size.cx))
         and (mdy>=y) and (mdy<=y+size.cy) then begin

        s:=''; p:=0;

        for i:=0 to strlen(st)-1 do begin
            s:=s+st[i]; p:=i;
            GetTextExtentPoint(DC,PChar(s),length(s),size);
            if (mdx<=(x+size.cx)) then break;
        end;

     if st[p]<>#32 then begin
        s:='';
        For i:=p downto 0 do begin
            if st[i]<>#32 then s:=st[i]+s
            else break;
        end;

        For i:=p+1 to length(st) do begin
            if st[i]<>#32 then s:=s+st[i]
            else break;
        end;
        MainForm.caption:=s;
       end else MainForm.caption:='';

     end;

  end;

  result:=f(DC,X,Y,opt,Rect,st,count,dx);
end;


procedure TMainForm.FormCreate(Sender: TObject);
var
p : PImportJump;
OldProtect : INTEGER;
begin
p := @ExtTextOut;
VirtualProtect(p^.Proc, 4, 
                               PAGE_EXECUTE_READWRITE, 
                               @OldProtect);
f:=p^.Proc^;

p^.Proc^ := @NewExtTextOut;

VirtualProtect(p^.Proc, 4, 
                               OldProtect, @OldProtect);

mdx:=0; mdy:=0;  isGetText:=False;

end;


procedure TMainForm.FormPaint(Sender: TObject);
begin
  Canvas.Font.Size:=25;
  Canvas.Font.Name:='Arial';
  Canvas.TextOut(10,10,'This is Hello World');

  Canvas.Font.Size:=16;
  Canvas.Font.Name:='Times New Roman';

  Canvas.TextOut(10,100,'Hi everybody I am Here');

  Canvas.Font.Size:=12;
  Canvas.Font.Name:='Courier';
  Canvas.TextOut(10,150,'Hi, Please Click Me');

end;

procedure TMainForm.FormMouseUp(Sender: TObject;
                                     Button: TMouseButton;
                                    Shift: TShiftState;
                                     X, Y: Integer);
var r:TRect;
begin
 if Button=mbRight then 
 begin
    mdx:=X; mdy:=Y; 
    isGetText:=True;
 
     R:=Rect(0,0,Width,Height);
     InvalidateRect(handle,@R,true);
    UpdateWindow(Handle);

 end;
end;

end.
